package Net::Coro::EV::FTP;
use common::sense;

use EV;
use Net::Coro::EV::FTP::Command;
use Net::Coro::EV::FTP::Data;
use Net::Coro::EV::Connect::Socket;

*BINDIP = \$Net::Coro::EV::Connect::Socket::BINDIP;
*TIMEOUT = \$Net::Coro::EV::FTP::Command::TIMEOUT;
*Net::Coro::EV::FTP::Data::TIMEOUT = \$Net::Coro::EV::FTP::Command::TIMEOUT;
our $DEBUG = 0;

use constant {
	DS_NONE => 0,
	DS_UPLOAD => 1,
};


sub new {
	my ($class, $cmd_socket, $data_socket) = @_;

	my $this = {};
	bless $this, $class;
	
	$cmd_socket = new Net::Coro::EV::Connect::Socket if !$cmd_socket;
	$data_socket = new Net::Coro::EV::Connect::Socket if !$data_socket;
	
	$this->{_CMD} = new Net::Coro::EV::FTP::Command ($cmd_socket);
	$this->{_DATA} = new Net::Coro::EV::FTP::Data ($data_socket);
	
	#$this->timeout($TIMEOUT);
	$this->id("#".rand()) if $DEBUG;

	return $this;
}
sub socket_cmd {$_[0]->{_CMD}->{_SOCKET}->child}
sub socket_data {$_[0]->{_DATA}->{_SOCKET}->child}

sub id {
	my ($this, $id) = @_;
	if (defined $id) {
		$this->{_ID} = $id;
		$this->{_CMD}->id($id);
		$this->{_DATA}->id($id);
	}
	$this->{_ID};
}

sub callback {
	my ($this, $code, $msg, $data) = @_;
	undef $this->{_ERRM};
	undef $this->{_ERRC};
	delete $this->{_ERR};
	my @prm = @{delete $this->{_PRM}};
	(delete $this->{_CB})->($this, $code, $msg, $data, @prm);
}

sub errc {$_[0]->{_ERRC}}
sub errm {$_[0]->{_ERRM}}

sub err {
	my ($this, $msg, $code) = @_;
	$this->{_ERRM} = $msg;
	$this->{_ERRC} = $code;

	# close all
	$this->close;
	
	# send error
	my @prm = @{delete $this->{_PRM}};
	my $cb = delete $this->{_CB};
	my $errcb = delete $this->{_ERR};
	if (!$errcb) {
		$cb->($this, undef,$msg,$code,$cb, @prm);
	} 
	else {
		$errcb->($this, $msg,$code,$cb,$errcb, @prm);
	}
}
sub close {
	my ($this) =@_;
	$this->{_CMD}->stop();
	$this->{_DATA}->stop();
}

sub stop {
	my ($this) = @_;
	$this->close();
	delete $this->{_CB};
	delete $this->{_PRM};
	delete $this->{_ERR};
}

sub timeout {
	my ($this, $val) = @_;	
	if (defined $val) {
		$this->{_TIMEOUT} = $val;
		$this->{_CMD}->timeout($val);
		$this->{_DATA}->timeout($val);
	}
	return $this->{_TIMEOUT};
}

sub timeout_conn {
	my ($this, $val) = @_;
	$this->{_CMD}->{_SOCKET}->timeout($val);
	$this->{_DATA}->{_SOCKET}->timeout($val);
}


sub bindip {
	$_[0]->{_CMD}->bindip($_[1]);
	$_[0]->{_DATA}->bindip($_[1]);
}

sub error {
	my ($this, $cberr) = @_;
	$this->{_ERR} = $cberr;
}





sub cmdcallback {
	my ($cmd, $code, $msg, $data, $this) = @_;
	$this->callback($code, $msg, $data);
}
sub oncmderror {
	my ($cmd, $msg,$code,$cb,$errcb, $this) = @_;
	$this->err($msg,$code);
}

# to do - decorate callback and error
sub cmd {
	my ($this, $cmd, $cb, @prm) = @_;
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;

	print "FTP CMD $this->{_ID}: $cmd\n" if $DEBUG;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd($cmd, \&cmdcallback,$this);
}
sub connect {
	my ($this, $host, $cb, @prm) = @_;
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;

	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->connect($host, \&cmdcallback, $this);
}

sub login {
	my ($this, $name, $pass, $cb, @prm) = @_;
	if (!$cb) {
		$cb = $name;
		$name = 'anonymous';
		$pass = rand().'@'.rand();
	}
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("USER $name", \&_onuser, $this, $pass);
}
sub _onuser {
	my ($cmd,   $code, $msg, $data,   $this, $pass) = @_;
	if ($code =~ /^[23]/s) {
		$cmd->error(\&oncmderror);
		$cmd->cmd("PASS $pass", \&_onpass, $this);
	} else {
		$this->callback($code, $msg, $data);
	}
}
sub _onpass {
	my ($cmd, $code, $msg, $data, $this) = @_;
	if ($code =~ /^2/s) {
		$cmd->error(\&oncmderror);
		$cmd->cmd("TYPE I", \&cmdcallback, $this);
	} else {
		$this->callback($code, $msg, $data);
	}
}


sub binary {
	my ($this, $cb, @prm) = @_;
	$this->cmd("TYPE I", $cb, @prm);
}
sub ascii {
	my ($this, $cb, @prm) = @_;
	$this->cmd("TYPE A", $cb, @prm);
}


sub pwd {
	my ($this, $cb, @prm) = @_;
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("PWD", \&_onpwd, $this);

}
sub _onpwd {
	my ($cmd,  $code, $msg, $data,  $this) = @_;
	if ($code =~ /^2/s) {
		my ($pathname, $message) = $msg =~ /"(\S+)"\s?(.*)/s;
		$pathname =~ s/""/"/sg;
		$pathname =~ s/\000/\n/sg;
		$this->callback($code, $message, $pathname);
	} else {
		$this->callback($code, $msg, $data);
	}
}





sub _pasv {
	my ($this, $cb, @prm) = @_;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("PASV", \&_onpasv, $this, $cb, \@prm);
}
sub _onpasv {
	my ($cmd,  $code, $msg, $data,  $this, $cb, $prm) = @_;
	if ($code =~ /^2/s) {
		my ($ip, $pt1, $pt2) = $msg =~ /((?:\d+,){4})(\d+),(\d+)/s;
		chop($ip);
		$ip =~ s/,/\./g;
		my $port = $pt1*256+$pt2;
		
		$this->{_DATA}->error(\&oncmderror);
		$this->{_DATA}->connect($ip, $port, $cb, @$prm);
	} else {
		$this->callback($code, $msg, $data);
	}
}


sub put {
	my ($this, $pathname, $filedata, $cb, @prm) = @_;
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	
	$this->_pasv(\&_put, $this, $pathname, $filedata);
}
sub _put {
	my ($data,  $response,  $this, $pathname, $filedata) = @_;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("STOR $pathname", \&_onputmark, $this, $filedata);
}
sub _onputmark {
	my ($cmd,  $code, $msg, $data,  $this, $filedata) = @_;
	if ($code =~ /^1/s) {
		# write to data channel. when done data chanel break connection. and server responds by command channel
		# if  errors occure  than server responds in command channel . so don't care about data channel errors.
		$this->{_DATA_STATE} = DS_UPLOAD;
		$this->{_DATA}->write($filedata, \&_onputdata, $this);
		
		$this->{_CMD}->error(\&oncmderror);
		$this->{_CMD}->read(\&_onputcallback, $this);
	} else {
		$this->{_DATA}->stop;
		$this->callback($code, $msg, $data);
	}
}
sub _onputdata {
	my ($data, $response, $this) = @_;
	$this->{_DATA_STATE} = DS_NONE;
	return '';
}

sub _onputcallback {
	my ($cmd, $code, $msg, $data, $this) = @_;
	
	return $this->callback($code, $msg, $data) if $this->{_DATA_STATE} == DS_NONE;
	
	# there was a break on data channel
	# call back if server handles error correct
	return $this->callback($code, $msg, $data) if $code !~ /^2/;
	
	# else emulate server side error handler
	$this->callback('426', 'data channel broken, upload aborted', "original server response (\$code, \$msg, \$data): $code, $msg, $data");
} 



sub get {
	my ($this, $pathname, $cb, @prm) = @_;
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	
	$this->_pasv(\&_get, $this, $pathname);
}
sub _get {
	my ($data,  $response,  $this, $pathname) = @_;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("RETR $pathname", \&_ongetmark, $this);
}
sub _ongetmark {
	my ($cmd, $code, $msg, $data, $this) = @_;
	if ($code =~ /^1/s) {
		# read from data connectnion
		$this->{_DATA}->error(\&ondataerror);
		$this->{_DATA}->read(\&_ongetdata, $this);
	} else {
		$this->{_DATA}->stop;
		$this->callback($code, $msg, $data);
	}
}
sub _ongetdata {
	my ($data, $response, $this) = @_;
	#data recived well
	#read from command connectnion end code
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->read(\&_onget, $this, $response);
}
sub _onget {
	my ($cmd,  $code, $msg, $data,  $this, $filedata) = @_;
	if ($code =~ /^2/s) {
		if (! defined($filedata)) {
			$this->callback('426', 'the file has (probably) been truncated', $data);
		} else {
			$this->callback($code, $msg, $filedata);
		}
	} else {
		$this->callback($code, $msg, $data);
	}
}
sub ondataerror {
	my ($data,  $msg,$code,$cb,$errcb, $this) = @_;
	$this->{_CMD}->read(\&_onget, $this, undef);
}




sub list {
	my ($this, $pathname, $cb, @prm) = @_;
	if (!$cb) {
		$cb = $pathname;
		$pathname = '';
	}
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	
	$this->_pasv(\&_list, $this, $pathname);
}
sub _list {
	my ($data,  $response,  $this, $pathname) = @_;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("LIST $pathname", \&_ongetmark, $this);
}

sub nlst {
	my ($this, $pathname, $cb, @prm) = @_;
	if (!$cb) {
		$cb = $pathname;
		$pathname = '';
	}
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	
	$this->_pasv(\&_nlst, $this, $pathname);
}
sub _nlst {
	my ($data,  $response,  $this, $pathname) = @_;
	$this->{_CMD}->error(\&oncmderror);
	$this->{_CMD}->cmd("NLST $pathname", \&_ongetmark, $this);
}






1;